home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / AmigaE / Src / OOmodules / list / associativeArray / ar2.e < prev    next >
Encoding:
Text File  |  1996-09-10  |  3.7 KB  |  164 lines
  1. /*
  2.  * ar2.e - yer very basic dumb program that reads a text file and counts the
  3.  * number of times each unique word occurs.  Words are used as the array index
  4.  * (key) in an associative array.  This is not -really- an E parser, so it's
  5.  * easier to follow if you use it on plain text, else you'll see some weird
  6.  * "words" and have to THINK to figure out where they're coming from. :)
  7.  *
  8.  * December 24 1995 Gregor Goldbach
  9.  *   This is the original test program by Barry. I just removed the initial size
  10.  *   value from the call to new().
  11.  *   I ran it over my guided dos autodoc (nearly 205Kb). It swallows nearly
  12.  *   800Kb :)
  13.  */
  14.  
  15. MODULE 'exec/strings'
  16. MODULE 'oomodules/list/associativeArray'
  17.  
  18. RAISE "OPEN" IF Open()=NIL,
  19.       "MEM" IF String()=NIL,
  20.       "^C" IF CtrlC()=TRUE
  21.  
  22. CONST SPACE=" ",
  23.       TAB=9
  24.  
  25. /*
  26.  * Derived class.
  27.  */
  28.  
  29. OBJECT myAsAr OF associativeArray
  30.   /* key will store pointers to strings */
  31.   /* val will store a count of the string's occurence */
  32. ENDOBJECT
  33.   /* myAsAr */
  34.  
  35. PROC disposeKey(key) OF myAsAr IS DisposeLink(key)
  36. PROC testKey(string1, string2) OF myAsAr IS OstrCmp(string1, string2)
  37.  
  38. /*---------------------------------------------------------------------------*/
  39.  
  40. /*
  41.  * TEST FUNCTIONS.
  42.  */
  43.  
  44. PROC isWhite(c)
  45.   SELECT c
  46.     CASE SPACE; RETURN TRUE
  47.     CASE TAB;   RETURN TRUE
  48.     CASE LF;    RETURN TRUE
  49.   ENDSELECT
  50. ENDPROC FALSE
  51.   /* isWhite */
  52.  
  53. PROC isPunct(c) IS (-1<>InStr('.,;:()/?-''"!@#$%^&*=+\\|[]{}<>`~', [c,0]:CHAR))
  54.   /* note: left out "_" for my test since identifiers can have them */
  55.  
  56. PROC skipSeparator(s)
  57.   DEF c
  58.   WHILE (isWhite(c:=s[]) OR isPunct(c)) DO INC s
  59. ENDPROC s
  60.   /* skipSeparator */
  61.  
  62. /*---------------------------------------------------------------------------*/
  63.  
  64. /*
  65.  * Add word to array and tally.
  66.  */
  67. PROC tallyWord(ar:PTR TO myAsAr, key) HANDLE
  68.   DEF val=0
  69.   val:=ar.get(key)
  70. EXCEPT DO
  71.   val:=val+1
  72.   ar.set(key, val)
  73. ENDPROC
  74.   /* tallyWord */
  75.  
  76. /*
  77.  * Make key from word.
  78.  */
  79. PROC makeKey(w)
  80.   DEF key
  81.   key:=String(EstrLen(w))
  82.   StrCopy(key, w)
  83. ENDPROC key
  84.   /* makeKey */
  85.  
  86. /*
  87.  * Pickup a word.
  88.  */
  89. PROC getWord(ar, s, w)
  90.   DEF key
  91.   SetStr(w, 0)
  92.   WHILE (isWhite(s[]) OR isPunct(s[])=FALSE) AND (s[]<>EOS)
  93.     StrAdd(w, s, 1)
  94.     INC s
  95.   ENDWHILE
  96.   IF EstrLen(w)
  97.     key:=makeKey(w)
  98.     tallyWord(ar, key)
  99.   ENDIF
  100. ENDPROC s
  101.   /* getWord */
  102.  
  103. /*
  104.  * Pickup all words in a line.
  105.  */
  106. PROC getWords(ar:PTR TO myAsAr, s, w)
  107.   LOOP
  108.     s:=skipSeparator(s)
  109.     IF s[]=EOS THEN RETURN
  110.     s:=getWord(ar, s, w)
  111.   ENDLOOP
  112. ENDPROC
  113.   /* getWords */
  114.  
  115. /*---------------------------------------------------------------------------*/
  116.  
  117. /*
  118.  * Print entire contents of array.
  119.  */
  120. PROC printEmAll(ar:PTR TO myAsAr)
  121.   DEF i, last, key:PTR TO LONG, val:PTR TO LONG
  122.   key:=ar.key
  123.   val:=ar.val
  124.   last:=ar.tail-1
  125.   FOR i:=0 TO last DO WriteF(' \s  ==  \d\n', key[i], val[i])
  126. ENDPROC
  127.   /* printEmAll */
  128.  
  129. /*---------------------------------------------------------------------------*/
  130.  
  131. /*
  132.  * MAIN.
  133.  */
  134. PROC main() HANDLE
  135.   DEF ar=NIL:PTR TO myAsAr
  136.   DEF fh=NIL, s=NIL, w=NIL
  137.   IF arg[]=EOS THEN Raise("ARGS")
  138.   fh:=Open(arg, OLDFILE)
  139.   s:=String(100)
  140.   w:=String(100)
  141.   NEW ar.new()
  142.   /* process the whole file, tallying word occurences into ar */
  143.   WHILE Fgets(fh, s, 100) DO getWords(ar, s, w)
  144.   /* print out the entire array */
  145.   printEmAll(ar)
  146. EXCEPT DO
  147.   IF fh THEN Close(fh)
  148.   SELECT exception
  149.     CASE ASAR_EXCEPTION
  150.       SELECT exceptioninfo
  151.         CASE ASAR_KEYNOTFOUND;   WriteF('bad key request\n')
  152.         CASE ASAR_STACKOVERFLOW; WriteF('stack overflow\n')
  153.       ENDSELECT
  154.     CASE "MEM";  WriteF('out of mem\n')
  155.     CASE "ARGS"; WriteF('examine which file?\n')
  156.     CASE "OPEN"; WriteF('can''t open file\n')
  157.     CASE "^C";   WriteF('interrupted\n')
  158.     CASE 0;
  159.     DEFAULT; WriteF('unknow exception \d/\d\n', exception, exceptioninfo)
  160.   ENDSELECT
  161.   CleanUp()
  162. ENDPROC
  163.   /* main */
  164.